home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
L' Effet Pommier 3
/
L'Effet Pommier - Volume 03.iso
/
Programmation
/
Alpha ƒ
/
Tcl
/
SystemCode
/
sendURL.tcl
< prev
next >
Wrap
Text File
|
1995-11-15
|
2KB
|
46 lines
# (WTP 7/30/95) Slightly improved 'sendURL'.
# By accepting a text arg, this can now be used to make sendURL
# hypertext links (useful for "mailto" links in documentation, f'rinstance)
#===============================================================================
set htmlEventSuiteIDs(MOSS) {WWW!}
proc sendUrl {{text {}}} {
if {$text == {}} { set text [getSelect] }
if {[string length $text] == 0} { return }
global htmlBrowserPath htmlEventSuiteIDs
if {![info exists htmlBrowserPath] || [catch {set sig [getFileSig $htmlBrowserPath]}]} {
if {[catch {addAppPath "HTML Browser" htmlBrowserPath}]} {
alertnote "You must choose an HTML browser"
return
}
set sig [getFileSig $htmlBrowserPath]
}
set name [checkRunning "HTML Browser" $sig htmlBrowserPath]
if {![string length $name]} {
alertnote "Couldn't run HTML browser"
return
}
if {![info exists htmlEventSuiteIDs($sig)]} {
alertnote "Can't send URLs to this HTML browser"
return
}
set suite $htmlEventSuiteIDs($sig)
AEBuild "'${sig}'" $suite {OURL} {----} "╥$text╙"
switchTo $name
}
proc expandURL {} {
set pos [getPos]
set beg [lineStart $pos]
if {[string length [set whe [search -s -n -f 1 -r 1 -i 1 -m 0 -l [nextLineStart $pos] {[a-zA-Z0-9]+://[a-zA-Z/._0-9~-]+} $beg]]]} {
if {($pos >= [lindex $whe 0]) && ($pos < [lindex $whe 1])} {
eval select $whe
return $whe
}
}
}